home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / cps / allocprof.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  11.7 KB  |  394 lines
  1. (* allocprof.sml *)
  2. (* Copyright 1989 by AT&T Bell Laboratories *)
  3. structure AllocProf =
  4. struct
  5.  
  6. local open Access Array CPS
  7. structure CGoptions = System.Control.CG
  8.  
  9. val ARRAYS =          0
  10. val ARRAYSIZE =       1
  11. val STRINGS =         2
  12. val STRINGSIZE =      3
  13. val REFCELLS =        4
  14. val REFLISTS =        5
  15. val CLOSURES =        6
  16. val CLOSURESLOTS =    11
  17. val CLOSUREOVFL =     (CLOSURES + CLOSURESLOTS)
  18. val KCLOSURES =       (CLOSUREOVFL + 1)
  19. val KCLOSURESLOTS =   11
  20. val KCLOSUREOVFL =    (KCLOSURES + KCLOSURESLOTS)
  21. val CCLOSURES =       (KCLOSUREOVFL + 1)
  22. val CCLOSURESLOTS =   11
  23. val CCLOSUREOVFL =    (CCLOSURES + CCLOSURESLOTS)
  24. val LINKS =           (CCLOSUREOVFL + 1)
  25. val LINKSLOTS =       11
  26. val LINKOVFL =        (LINKS + LINKSLOTS)
  27. val SPLINKS =         (LINKOVFL + 1)
  28. val SPLINKSLOTS =     11
  29. val SPLINKOVFL =      (SPLINKS + SPLINKSLOTS)
  30. val RECORDS =         (SPLINKOVFL + 1)
  31. val RECORDSLOTS =     11
  32. val RECORDOVFL =      (RECORDS + RECORDSLOTS)
  33. val SPILLS =          (RECORDOVFL + 1)
  34. val SPILLSLOTS =      21
  35. val SPILLOVFL =       (SPILLS + SPILLSLOTS)
  36. val KNOWNCALLS =      (SPILLOVFL + 1)
  37. val STDKCALLS =       (KNOWNCALLS + 1)
  38. val STDCALLS =        (STDKCALLS + 1)
  39. val CNTCALLS =        (STDCALLS + 1)
  40. val CNTKCALLS =       (CNTCALLS + 1)
  41. val CSCNTCALLS =      (CNTKCALLS + 1)
  42. val CSCNTKCALLS =     (CSCNTCALLS + 1)
  43. val ARITHOVH =        (CSCNTKCALLS+1)
  44. val ARITHSLOTS =      5
  45. (* Make sure the array assigned to varptr in the runtime system is at
  46.    least this big!!  Test how big by doing an allocReset from batch. *)
  47. val PROFSIZE =        (ARITHOVH+ARITHSLOTS)
  48.  
  49. in
  50.  
  51. local
  52. fun prof(s,i) = (* Header to increment slot s by i *)
  53.  (fn ce => let val a1 = mkLvar() and a2 = mkLvar()
  54.            and x = mkLvar() and n = mkLvar()
  55.        in  LOOKER(P.getvar,nil,a1,
  56.            LOOKER(P.subscript,[VAR a1,INT s],x,
  57.            ARITH(P.+,[VAR x,INT i],n,
  58.            LOOKER(P.getvar,nil,a2,
  59.            SETTER(P.unboxedupdate,[VAR a2,INT s,VAR n],ce)))))
  60.        end)
  61.  
  62. fun profSlots(base,slots,ovfl) cost =
  63.   if cost < slots
  64.   then prof(base+cost,1)
  65.   else prof(base,1) o prof(ovfl,cost)
  66.  
  67. val id = (fn x => x)
  68. in
  69.  
  70. local val profLinks0 = profSlots(LINKS,LINKSLOTS,LINKOVFL) in
  71. fun profLinks(cost) =
  72.   if cost=0 then id
  73.   else profLinks0 cost
  74. end
  75.  
  76. fun profRecLinks(l) = fold (fn (cost,h) => profLinks(cost) o h)
  77.                            l id
  78.  
  79. local val profRecord0 = profSlots(RECORDS,RECORDSLOTS,RECORDOVFL) in
  80. fun profRecord(cost) =
  81.   if cost=0 then id
  82.   else profRecord0 cost
  83. end
  84.  
  85. val profClosure = profSlots(CLOSURES,CLOSURESLOTS,CLOSUREOVFL)
  86.  
  87. val profKClosure = profSlots(KCLOSURES,KCLOSURESLOTS,KCLOSUREOVFL)
  88.  
  89. val profCClosure = profSlots(CCLOSURES,CCLOSURESLOTS,CCLOSUREOVFL)
  90.  
  91. val profSpill = profSlots(SPILLS,SPILLSLOTS,SPILLOVFL)
  92.  
  93. val profStdCall = prof(STDCALLS,1)
  94.  
  95. val profStdkCall = prof(STDKCALLS,1)
  96.  
  97. val profCntCall = prof(CNTCALLS,1)
  98.  
  99. val profCntkCall = prof(CNTKCALLS,1)
  100.  
  101. val profCSCntCall = prof(CSCNTCALLS,1)
  102.  
  103. val profCSCntkCall = prof(CSCNTKCALLS,1)
  104.  
  105. val profKnownCall = prof(KNOWNCALLS,1)
  106.  
  107. val profRefCell = prof(REFCELLS,1)
  108.  
  109. val profRefList = prof(REFLISTS,1)
  110.  
  111. end (* local *)
  112.  
  113.  
  114. local
  115. val im = Integer.makestring
  116. val pr = System.Print.say
  117. val printf = app pr
  118. (* Right justify st in a string of length w. *)
  119. fun field (st,w) =
  120.   if w <= String.length st then st
  121.   else let val s = "                              " ^ st
  122.        in substring(s,String.length s - w, w)
  123.        end
  124.  
  125. fun ifield(i,w) = field(im i,w)
  126. (* Put a decimal point at position w in string st. *)
  127. fun decimal(st,w) =
  128.   let val l = String.length st - w
  129.       val a = if (l <= 0) then "0" else substring(st,0,l)
  130.       val st' = "0000000000" ^ st
  131.   in  a ^ "." ^ substring(st',String.length st' - w,w)
  132.   end
  133. fun muldiv(i,j,k) =
  134.     (i*j div k) handle Overflow => muldiv(i,j div 2, k div 2)
  135. fun decfield(n,j,k,w1,w2) = 
  136.     field(decimal(im (muldiv(n,j,k)),w1)
  137.         handle Div => "",w2)
  138. (* Returns the percentage i/j to 1 decimal place in a field of width k *)
  139. fun percent(i,j,k) = decfield(1000,i,j,1,k)
  140. (* Returns the percentage i/j to 2 decimal places in a field of width k *)
  141. fun percent2(i,j,k) = decfield(10000,i,j,2,k)
  142.  
  143. fun for(start,upto,f) =
  144.   let fun iter(i,cum:int) = if i < upto then iter(i+1,cum + f(i)) else cum
  145.   in  iter(start,0)
  146.   end
  147. fun for'(start,upto,f) =
  148.     let fun iter(i) = if i < upto then (f(i); iter(i+1)) else ()
  149.   in  iter(start)
  150.   end
  151.  
  152. in
  153.  
  154. fun print_profile_info() =
  155.   let val profvec : int array = System.Unsafe.getvar()
  156.       fun getprof(x) = sub(profvec,x)
  157.       fun links(i) = getprof(LINKS+i)
  158.       fun closures(i) = getprof(CLOSURES+i)
  159.       fun kclosures(i) = getprof(KCLOSURES+i)
  160.       fun cclosures(i) = getprof(CCLOSURES+i)
  161.       fun records(i) = getprof(RECORDS+i)
  162.       fun spills(i) = getprof(SPILLS+i)
  163.  
  164.       val num_calls = getprof(KNOWNCALLS)
  165.                     + getprof(STDKCALLS) + getprof(STDCALLS)
  166.             + getprof(CNTKCALLS) + getprof(CNTCALLS)
  167.             + getprof(CSCNTKCALLS) + getprof(CSCNTCALLS)
  168.  
  169.       val num_closures = for(0, CLOSURESLOTS,fn i => closures(i))
  170.       val space_closures = for(1, CLOSURESLOTS, fn i => closures(i) * (i+1))
  171.       val space_closures = space_closures + getprof(CLOSUREOVFL) + closures(0)
  172.  
  173.       val num_kclosures = for(0, KCLOSURESLOTS,fn i => kclosures(i))
  174.       val space_kclosures = for(1, KCLOSURESLOTS, fn i => kclosures(i) * (i+1))
  175.       val space_kclosures = space_kclosures + getprof(KCLOSUREOVFL) + kclosures(0)
  176.  
  177.       val num_cclosures = for(0, CCLOSURESLOTS,fn i => cclosures(i))
  178.       val space_cclosures = for(1, CCLOSURESLOTS, fn i => cclosures(i) * (i+1))
  179.       val space_cclosures = space_cclosures + getprof(CCLOSUREOVFL) + cclosures(0)
  180.  
  181.       val num_closure_accesses = for(0, LINKSLOTS, fn i => links(i))
  182.       val num_links_traced = for(1, LINKSLOTS, fn i => links(i) * i)
  183.       val num_links_traced = num_links_traced + getprof(LINKOVFL)
  184.  
  185.       val num_records = for(0, RECORDSLOTS, fn i => records(i))
  186.       val space_records = for(1, RECORDSLOTS, fn i => records(i) * (i+1))
  187.       val space_records = space_records + getprof(RECORDOVFL) + records(0)
  188.  
  189.       val num_spills = for(0, SPILLSLOTS, fn i => spills(i))
  190.       val space_spills = for(1, SPILLSLOTS, fn i => spills(i) * (i+1))
  191.       val space_spills = space_spills + getprof(SPILLOVFL) + spills(0)
  192.       val total = space_closures + space_kclosures + space_cclosures
  193.             + space_records + space_spills
  194.         + getprof(ARRAYSIZE) + getprof(ARRAYS)
  195.         + getprof(STRINGSIZE) + getprof(STRINGS)
  196.         + getprof(REFCELLS) * 2
  197.         + getprof(REFLISTS) * 2
  198.  
  199.       val descriptors = num_closures + num_kclosures + num_cclosures
  200.              + num_records + num_spills
  201.          + getprof(ARRAYS) + getprof(STRINGS)+ getprof(REFCELLS)
  202.  
  203.       val sgetprof = im o getprof
  204.       
  205.       fun printLinks() =
  206.         if num_closure_accesses>0 then
  207.     (for'(1, LINKSLOTS,
  208.           fn k => 
  209.          if links(k) > 0 then
  210.          printf[ifield(k,4),
  211.             ifield(links(k),13),
  212.             percent(links(k),num_closure_accesses,12),
  213.             "%",
  214.             ifield(links(k) * k,12),
  215.             percent(links(k) * k, num_links_traced, 9),
  216.             "%\n"]
  217.          else ());
  218.      if links(0) > 0 then
  219.          printf[">",
  220.             ifield(LINKSLOTS - 1,5),
  221.             ifield(links(0),9),
  222.             percent(links(0),num_closure_accesses,10),
  223.             "%",
  224.             ifield(getprof(LINKOVFL),13),
  225.             percent(getprof(LINKOVFL),num_links_traced,10),
  226.             "%\n"]
  227.      else ();
  228.  
  229.      printf[decfield(100,num_links_traced,num_closure_accesses,2,0),
  230.         " links were traced per access on average.\n\n"]
  231.      ) else printf["\n"] (* end function printLinks *)
  232.  
  233.       fun print1(num,name,slots,getstat,ovfl,space) =
  234.         if num>0 then
  235.     (printf[name,":\n"];
  236.      for'(1, slots,
  237.           fn k => 
  238.          if getstat(k) > 0 then
  239.          printf[ifield(k,6),
  240.             ifield(getstat(k),9),
  241.             percent(getstat(k),num,9),
  242.             "%",
  243.             ifield(getstat(k) * (k+1),13),
  244.             percent(getstat(k) * (k+1), total, 10),
  245.             "%\n"]
  246.          else ());
  247.      if getstat(0) > 0 then
  248.          printf[">",
  249.             ifield(slots - 1,5),
  250.             ifield(getstat(0),9),
  251.             percent(getstat(0),num,9),
  252.             "%",
  253.             ifield(getprof(ovfl)+getstat(0),13),
  254.             percent(getprof(ovfl)+getstat(0),total,10),
  255.             "%\n"]
  256.      else ();
  257.  
  258.      printf["total:",
  259.         ifield(num,9),
  260.         ifield(space,23),
  261.         percent(space,total,10),
  262.         "%  Average size ",
  263.         decfield(100,space-num,num,2,0),
  264.         "\n\n"]
  265.      ) else if (String.length(name) > 12)
  266.             then printf[name,": 0\n\n"]
  267.         else printf[name,": ",
  268.                 ifield(0,13 - String.length(name)),"\n\n"]
  269.       (* end function print1 *)
  270.  
  271.       fun print2(stat,size,name) =
  272.     if getprof(stat) <> 0 then
  273.     printf[name,
  274.            ifield(getprof(stat),6),
  275.            ifield(getprof(size) + getprof(stat), 23),
  276.            percent(getprof(size) + getprof(stat),total,10),
  277.            "%  Average size ",
  278.            decfield(100,getprof(size),getprof(stat),2,0),
  279.            "\n"]
  280.     else printf[name,ifield(0,6),"\n"]
  281.  
  282.       fun print3(stat,name) =
  283.         if getprof(stat) <> 0 then
  284.     printf[name,
  285.            ifield(getprof(stat),6),
  286.            ifield(getprof(stat) * 2, 23),
  287.            percent(getprof(stat) * 2,total,10),
  288.            "%\n"]
  289.     else printf[name,ifield(0,6),"\n"]
  290.  
  291.   in  pr "\n-------------------- ALLOCATION PROFILE --------------------\n\n";
  292.  
  293.       pr "\n                 ----- FUNCTION CALLS -----\n";
  294.       if (num_calls > 0) then
  295.       printf["Known functions:                 ",
  296.          ifield(getprof(KNOWNCALLS),10),
  297.          " (",
  298.          percent(getprof(KNOWNCALLS),num_calls,4),
  299.          "%)\n",
  300.  
  301.          "Escaping functions:              ",
  302.          ifield(getprof(STDCALLS),10),
  303.          " (",
  304.          percent(getprof(STDCALLS),num_calls,4),
  305.          "%)\n",
  306.  
  307.  
  308.          "Known escaping functions:        ",
  309.          ifield(getprof(STDKCALLS),10),
  310.          " (",
  311.          percent(getprof(STDKCALLS),num_calls,4),
  312.          "%)\n",
  313.  
  314.          "Continuations:                   ",
  315.              ifield(getprof(CNTCALLS),10),
  316.          " (",
  317.          percent(getprof(CNTCALLS),num_calls,4),
  318.          "%)\n",
  319.  
  320.          "Known continuations:             ",
  321.              ifield(getprof(CNTKCALLS),10),
  322.          " (",
  323.          percent(getprof(CNTKCALLS),num_calls,4),
  324.          "%)\n",
  325.  
  326.          "Callee-save continuations:       ",
  327.              ifield(getprof(CSCNTCALLS),10),
  328.          " (",
  329.          percent(getprof(CSCNTCALLS),num_calls,4),
  330.          "%)\n",
  331.  
  332.          "Known callee-save continuations: ",
  333.              ifield(getprof(CSCNTKCALLS),10),
  334.          " (",
  335.          percent(getprof(CSCNTKCALLS),num_calls,4),
  336.          "%)\n"]
  337.       else ();
  338.       printf["\nTotal function calls:            ",
  339.          ifield(num_calls,10),"\n\n"];
  340.  
  341.  
  342.       pr "\n                ----- CLOSURE ACCESSES -----\n";
  343.       printf["Closure elements were accessed ",
  344.          im num_closure_accesses,
  345.          " times through ",
  346.          im num_links_traced,
  347.          " links:\n",
  348.          "Size     Accesses   % accesses       Links   % links\n"];
  349.       printLinks();
  350.  
  351.       pr "\n                ----- HEAP ALLOCATIONS -----\n";
  352.       pr "             (only total sizes include descriptors)\n\n";
  353.       printf["TOTAL size ", im total];
  354.       if (total > 0) then (
  355.       printf["; ",
  356.          im descriptors, " descriptors accounted for ",
  357.          percent(descriptors,total,0), "%.\n\n"])
  358.       else printf[".\n\n"];
  359.  
  360.       printf["  Size   Number   % total   Total size    % TOTAL\n\n"];
  361.  
  362.       print1(num_closures,"Closures for escaping functions",
  363.          CLOSURESLOTS,closures,CLOSUREOVFL,space_closures);
  364.       print1(num_kclosures,"Closures for known functions",
  365.          KCLOSURESLOTS,kclosures,KCLOSUREOVFL,space_kclosures);
  366.       print1(num_cclosures,"Closures for callee-save continuations",
  367.          CCLOSURESLOTS,cclosures,CCLOSUREOVFL,space_cclosures);
  368.  
  369.       print1(num_records,"Records",RECORDSLOTS,records,
  370.          RECORDOVFL,space_records);
  371.       print1(num_spills,"Spills",SPILLSLOTS,spills,
  372.          SPILLOVFL,space_spills);
  373.  
  374.       print2(ARRAYS,ARRAYSIZE,"Arrays:  ");
  375.       print2(STRINGS,STRINGSIZE,"Strings: ");
  376.  
  377.       print3(REFCELLS,"Refs:    ");
  378.       print3(REFLISTS,"Ref\n list:   ")
  379.  
  380.  
  381.   end (* fun print_profile_info *)
  382.  
  383.  
  384. end (* local *)
  385.  
  386. fun reset() = (print "New  alloc profvec, size "; print PROFSIZE; print "\n";
  387.            System.Unsafe.setvar(array(PROFSIZE,0)))
  388.  
  389.  
  390. end (* local *)
  391.  
  392.  
  393. end (* structure AllocProf *)
  394.